home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / brush / brush.bas next >
Encoding:
BASIC Source File  |  1995-05-09  |  2.2 KB  |  68 lines
  1. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  2. '
  3. '                 PatternBrush (FreeWare)
  4. '
  5. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  6. '                  written by dirk hilger
  7. '                   for bytes & letters
  8. '                          germany
  9. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  10.  
  11. Option Explicit
  12. Declare Function rectangle% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
  13. Declare Function getDC% Lib "User" (ByVal hWnd%)
  14. Declare Function releaseDC% Lib "User" (ByVal hWnd%, ByVal hDC%)
  15. Declare Function selectobject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  16. Declare Function createPatternBrush% Lib "GDI" (ByVal hBitmap%)
  17. Declare Function createPen% Lib "GDI" (ByVal nPenStyle%, ByVal nWidth%, ByVal crColor&)
  18. Declare Function deleteobject% Lib "GDI" (ByVal hObject%)
  19.  
  20. Sub brush_control (c As Control, ByVal hBMP%, ByVal borderwidth%)
  21.     Dim os%, w%, h%, x%, y%, tf%
  22.     Dim hDC%, hWnd%
  23.     hWnd = c.hWnd
  24.     hDC = getDC(hWnd)
  25.     os = c.Parent.ScaleMode
  26.     c.Parent.ScaleMode = 3
  27.     x = borderwidth + c.Left
  28.     y = borderwidth + c.Top
  29.     w = c.Width + 1 - borderwidth
  30.     h = c.Height + 1 - borderwidth
  31.     showbrush hDC, hBMP, x, y, w, h
  32.     c.Parent.ScaleMode = os
  33.     tf = releaseDC(hWnd, hDC)
  34. End Sub
  35.  
  36. Sub brush_form (f As Form, ByVal hBMP%)
  37.     Dim os%, w%, h%
  38.     os = f.ScaleMode
  39.     f.ScaleMode = 3
  40.     w = f.ScaleWidth + 1
  41.     h = f.ScaleHeight + 1
  42.     showbrush f.hDC, hBMP%, 0, 0, w, h
  43.     f.ScaleMode = os
  44. End Sub
  45.  
  46. Sub form_center (f As Form)
  47.     On Local Error Resume Next
  48.     f.Left = (screen.Width - f.Width) \ 2
  49.     f.Top = (screen.Height - f.Height) \ 2
  50. End Sub
  51.  
  52. Private Sub showbrush (ByVal hDC%, ByVal hBMP%, ByVal x%, ByVal y%, ByVal w%, ByVal h%)
  53.     Dim hbrold%, hbr%, tf%, hpen%, hpenold%
  54.     
  55.     If hBMP = False Then Exit Sub
  56.     hbr = createPatternBrush(hBMP%)
  57.     hpen = createPen(5, 1, 0)
  58.     hbrold = selectobject(hDC, hbr)
  59.     hpenold = selectobject(hDC, hpen)
  60.     tf = rectangle(hDC, x, y, w, h)
  61.     hbr = selectobject(hDC, hbrold)
  62.     hpen = selectobject(hDC, hpenold)
  63.     tf = deleteobject(hbr)
  64.     tf = deleteobject(hpen)
  65.  
  66. End Sub
  67.  
  68.